home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / TIPS / WINPRINT.PAS < prev   
Pascal/Delphi Source File  |  1991-10-09  |  15KB  |  457 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows                     }
  4. {   Tips & Techniques Demo Program               }
  5. {   Copyright (c) 1991 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. unit WinPrint;
  10.  
  11. {$R PRINTER}
  12.  
  13. interface
  14.  
  15. uses WinTypes, WinProcs, WObjects, Strings;
  16.  
  17. type
  18.  
  19. { TComboXferRec }
  20. { The transfer buffer used for the ComboBox in the TPrinterInfo method
  21.   SelectPrinter.  The fields, Strings and Selection, are set up in the
  22.   TPrinterInfo constructor Init.  The routine GetCurrentPrinter is used
  23.   to find current printing device which is placed in Selection.  And the
  24.   routine GetPrinterTypes is used to fill out the Strings field.}
  25.  
  26.   TComboXferRec = record
  27.     Strings: PStrCollection;
  28.     Selection: array[0..80] of Char;
  29.   end;
  30.  
  31. { TAbortDialog }
  32. { A descendant of TDialog used for the Abort Dialog seen when printing is
  33.   in progress. The AbortDialog is installed as a data field of TPrinterInfo
  34.   and is initialized and displayed in its StartDoc method. The EndDoc
  35.   method will Close the dialog if necessary.}
  36.  
  37.   PAbortDialog = ^TAbortDialog;
  38.   TAbortDialog = object(TDlgWindow)
  39.    procedure SetUpWindow; virtual;
  40.    procedure WMCommand(var Msg: TMessage);
  41.      virtual wm_First + wm_Command;
  42.   end;
  43.  
  44. { TPrinterInfo }
  45. { The controlling object for printing.  It is intended that this object be
  46.   initialized as a data field of a TWindow or TApplication descendant. This
  47.   printing object must be used OWL based applications. The data fields are
  48.   not supposed to be used directly but may need to be accessed in special
  49.   situations.  PrintDC and Error are the two most likely to be used without
  50.   a specific method call.  The description of the data fields are as
  51.   follows.
  52.  
  53.   -AbortDialog holds a pointer to the abort dialog when it valid.  It is
  54.   valid only after a call to the method StartDoc and before the call to the
  55.   method EndDoc.
  56.  
  57.   -AbortCallBackProc holds the address of the Abort Dialog's callback
  58.   function.  It's definition is found in the function AbortCallBack in the
  59.   implementation section of this unit.
  60.  
  61.   -SelectDialog is a pointer to the dialog used when selecting the current
  62.   printer. To be used when overriding the function of the SelectPrinter
  63.   method.
  64.  
  65.   -SelectInfo is the transfer record used in SelectDialog.  Holds
  66.   descriptions of all printers available and the currently selected printer.
  67.  
  68.   -Driver, PrinterType, Port are null terminated strings holding information
  69.   relevant to the current printer.
  70.  
  71.   -DriverHandle is a handle to the library of the current printer driver. It
  72.   is setup in Init constructor and is freed in the Done destructor.  It is
  73.   used for setting up the DeviceMode configuration call.
  74.  
  75.   -PrintDC is the device control established for printing. It is created by
  76.   the StartDoc method and valid until the EndDoc method call. May be
  77.   accessed directly or by the GetPrinterDC method call.
  78.  
  79.   -Error holds the results of printer escape calls.  If an error occurs, the
  80.   result is placed here.  Is tested to determine if further printing output
  81.   is appropriate.
  82.  
  83.   -ExtDeviceMode holds the ExtDeviceMode procedure used for retrieving,
  84.   installing, and prompting for printing configurations.
  85.  
  86.   -DeviceModeVar holds the DeviceMode procedure used for prompting the
  87.   user for printer configurations.
  88. }
  89.  
  90.   PPrinterInfo = ^TPrinterInfo;
  91.   TPrinterInfo = object
  92.     AbortDialog: PAbortDialog;
  93.     AbortCallBackProc: TFarProc;
  94.     SelectDialog: PDialog;
  95.     SelectInfo: TComboXferRec;
  96.     Driver,
  97.     PrinterType,
  98.     Port: PChar;
  99.     DriverHandle: THandle;
  100.     PrintDC: HDC;
  101.     Error: Integer;
  102.     ExtDeviceMode: TExtDeviceMode;
  103.     DeviceModeVar: TDeviceMode;
  104.     RasterCaps: integer;
  105.     constructor Init;
  106.     destructor Done;
  107.     procedure SelectPrinter; virtual;
  108.     function GetPrinterDC: HDC;
  109.     procedure DeviceMode;
  110.     function BitMapCapable: boolean;
  111.     function BandingRequired: boolean;
  112.     procedure StartDoc(Name: PChar); virtual;
  113.     procedure NewFrame; virtual;
  114.     procedure NextBand(var R:TRect); virtual;
  115.     procedure EndDoc; virtual;
  116.   end;
  117.  
  118.  
  119. var
  120.   PrinterAbort: Boolean;
  121. { Holds true when the user has aborted printing. }
  122.  
  123. implementation
  124.  
  125. const
  126.   id_ComboBox = 101;
  127. { ID for the ComboBox used for Selecting the current printer }
  128.  
  129. var
  130.   AbortWindow: HWnd;
  131. { Window handle for the Abort Dialog.  It is used by the
  132.   AbortCallBackProc.}
  133.  
  134. function GetItem(var S: PChar): PChar;
  135. { Retrieves comma separated data from a null terminated string. It
  136.   returns the first data item and advances the pointer S to the next
  137.   data item in the string.}
  138. var
  139.   P: PChar;
  140.   I: Integer;
  141.  
  142. begin
  143.   I:=0;
  144.   while (S[I]<>',') and (S[I]<>#0) do
  145.     inc(I);
  146.   S[I]:=#0;
  147.   GetMem(P, Strlen(S)+1);
  148.   StrCopy(P,S);
  149.   GetItem:=P;
  150.   if S[0]<>#0 then S:=@S[I+1];
  151. end;
  152.  
  153. procedure GetPrinterTypes(var PrinterTypes: PStrCollection);
  154. { Retrieves all the device types from the WIN.INI and places this
  155.   information into the PStrCollection parameter.}
  156. var
  157.   Buffer, BufferItem: PChar;
  158.   Item: PChar;
  159.   Count, I: Integer;
  160.  
  161. begin
  162.   New(PrinterTypes, init(5,1));
  163.   GetMem(Buffer, 1024);
  164.   Count:=GetProfileString('devices', nil, ',,', Buffer, 1024);
  165.   BufferItem:=Buffer;
  166.   I:=0;
  167.   while I<Count do
  168.   begin
  169.     GetMem(Item, StrLen(BufferItem)+1);
  170.     StrCopy(Item, BufferItem);
  171.     PrinterTypes^.Insert(Item);
  172.     while (BufferItem[i]<>#0) and (I<Count) do
  173.       inc(I);
  174.     inc(I);
  175.     if BufferItem[I]=#0 then I:=Count;
  176.     if I<Count then
  177.     begin
  178.       BufferItem:=@BufferItem[I];
  179.       Count:=Count-I;
  180.       I:=0;
  181.     end;
  182.   end;
  183.   FreeMem(Buffer, 1024);
  184. end;
  185.  
  186. procedure GetCurrentPrinter(var Driver, PrinterType, Port: PChar);
  187. { Retrieves the current printing device information from the WIN.INI
  188.   file.}
  189. var
  190.   ProfileInfo, CurrentItem: PChar;
  191. begin
  192.   GetMem(ProfileInfo, 80+1);
  193.   GetProfileString('windows', 'device', ',,', ProfileInfo, 80);
  194.   CurrentItem:=ProfileInfo;
  195.   PrinterType:=GetItem(CurrentItem);
  196.   Driver:=GetItem(CurrentItem);
  197.   Port:=GetItem(CurrentItem);
  198.   FreeMem(ProfileInfo, 80+1);
  199. end;
  200.  
  201. procedure GetPrinter(PrinterType: PChar; var Driver, Port: PChar);
  202. { Given a PrinterType string, this procedure returns the appropriate
  203.   driver and port information.}
  204.  
  205. var
  206.   ProfileInfo, CurrentItem: PChar;
  207.  
  208. begin
  209.   GetMem(ProfileInfo, 80+1);
  210.   GetProfileString('devices', PrinterType, ',', ProfileInfo, 80);
  211.   CurrentItem:=ProfileInfo;
  212.   Driver:=GetItem(CurrentItem);
  213.   Port:=GetItem(CurrentItem);
  214. end;
  215.  
  216. procedure TAbortDialog.SetUpWindow;
  217. { Initializes PrinterAbort and AbortWindow. Then set the focus to the
  218.   AbortDialog.}
  219. begin
  220.   PrinterAbort:=false;
  221.   SetFocus(HWindow);
  222.   AbortWindow:=HWindow;
  223. end;
  224.  
  225. procedure TAbortDialog.WMCommand(var Msg: TMessage);
  226. { If any command messages occur, a user abort has taken place.  Normally,
  227.   this will include pressing ENTER, ESCAPE, the SPACEBAR  or clicking the
  228.   mouse on the Abort Dialog's Escape button.}
  229. begin
  230.   PrinterAbort:=true;
  231. end;
  232.  
  233. function AbortCallBack(DC: HDC; Code: Integer): Bool; export;
  234. { While printing is taking place, checks to see if PrinterAbort is
  235.   true.  Otherwise messages are passed on.}
  236. var
  237.   Msg: TMsg;
  238. begin
  239.   while (not PrinterAbort) and PeekMessage(Msg, 0, 0, 0, pm_Remove) do
  240.   if not IsDialogMessage(AbortWindow, Msg) then
  241.   begin
  242.     TranslateMessage(Msg);
  243.     DispatchMessage(Msg);
  244.   end;
  245.   if PrinterAbort then AbortCallBack:=false else AbortCallBack:=true;
  246. end;
  247.  
  248. constructor TPrinterInfo.Init;
  249. { Gets the current printer information (Type, Driver, & Port) and
  250.   the printer types currently available.  Then retrieves the
  251.   ExtDeviceMode and DeviceModeVar address from the current printer's
  252.   library.}
  253. var
  254.   I: Integer;
  255.   FullDriverName: PChar;
  256.   P: TFarProc;
  257.  
  258. begin
  259.   GetCurrentPrinter(Driver, PrinterType, Port);
  260.   for I:= 0 to StrLen(PrinterType) do
  261.     SelectInfo.Selection[I]:=PrinterType[I];
  262.   GetPrinterTypes(SelectInfo.Strings);
  263.  
  264.   GetMem(FullDriverName, 12+1);
  265.   StrLCat(StrCopy(FullDriverName, Driver), '.DRV', 12);
  266.   DriverHandle:=LoadLibrary(FullDriverName);
  267.   FreeMem(FullDriverName, 12+1);
  268.  
  269.   P:=GetProcAddress(DriverHandle, 'ExtDeviceMode');
  270.   ExtDeviceMode:=TExtDeviceMode(P);
  271.   P:=GetProcAddress(DriverHandle, 'DeviceMode');
  272.   DeviceModeVar:=TDeviceMode(P);
  273.   PrintDC:=0;
  274. end;
  275.  
  276. destructor TPrinterInfo.Done;
  277. { Frees up the library taken in the constructor Init.}
  278. begin
  279.   FreeLibrary(DriverHandle);
  280. end;
  281.  
  282. procedure TPrinterInfo.SelectPrinter;
  283. { Displays a Printer Select dialog called PISELECT and changes the
  284.   current printer information as is done in Init.}
  285. var
  286.   FullDriverName: PChar;
  287.   P: TFarProc;
  288.   ComboBox: PComboBox;
  289.  
  290. begin
  291.   new(SelectDialog, Init(Application^.MainWindow,
  292.     'PISELECT'));
  293.   New(ComboBox, InitResource(SelectDialog, id_ComboBox, 80));
  294.  
  295.   SelectDialog^.TransferBuffer:=@SelectInfo;
  296.   if Application^.ExecDialog(SelectDialog) = id_Ok then
  297.   begin
  298.     FreeLibrary(DriverHandle);
  299.     if PrintDC<>0 then DeleteDC(PrintDC);
  300.     FreeMem(PrinterType, StrLen(PrinterType)+1);
  301.     GetMem(PrinterType, StrLen(@SelectInfo.Selection)+1);
  302.  
  303.     StrCopy(PrinterType, @SelectInfo.Selection);
  304.  
  305.     FreeMem(Driver, StrLen(Driver)+1);
  306.     FreeMem(Port, StrLen(Port)+1);
  307.     GetPrinter(PrinterType, Driver, Port);
  308.  
  309.     GetMem(FullDriverName, 12+1);
  310.     StrLCat(StrCopy(FullDriverName, Driver), '.DRV', 12);
  311.     DriverHandle:=LoadLibrary(FullDriverName);
  312.     FreeMem(FullDriverName, 12+1);
  313.  
  314.     P:=GetProcAddress(DriverHandle, 'ExtDeviceMode');
  315.     ExtDeviceMode:=TExtDeviceMode(P);
  316.     P:=GetProcAddress(DriverHandle, 'DeviceMode');
  317.     DeviceModeVar:=TDeviceMode(P);
  318.   end;
  319. end;
  320.  
  321. function TPrinterInfo.GetPrinterDC: HDC;
  322. { Retrieves the Device control associated with the printer.  May only be
  323.   called after a call to the StartDoc method. }
  324. begin
  325.   GetPrinterDC:=PrintDC;
  326. end;
  327.  
  328. procedure TPrinterInfo.StartDoc(Name: PChar);
  329. { Called immediately before printing is to begin.  Establishes the
  330.   device control.  Sets up the Abort Dialog. And send the STARTDOC
  331.   escape call.}
  332. begin
  333.   Error:=0;
  334.   PrintDC:=CreateDC(Driver, PrinterType, Port, nil);
  335.   if LowMemory then
  336.     AbortDialog:=Nil
  337.   else
  338.   begin
  339.     new(AbortDialog, Init(Application^.MainWindow, 'PIABORT'));
  340.     AbortDialog^.Create;
  341.   end;
  342.   if AbortDialog<>Nil then
  343.   begin
  344.     AbortCallBackProc:=MakeProcInstance(@AbortCallBack, HInstance);
  345.     Escape(PrintDC, SETABORTPROC, 0, AbortCallBackProc, nil);
  346.   end;
  347.   RasterCaps:=GetDeviceCaps(PrintDC, WINTYPES.RASTERCAPS);
  348.   Error:=Escape(PrintDC, WINTYPES.STARTDOC, StrLen(Name), Name, nil);
  349. end;
  350.  
  351. procedure TPrinterInfo.NewFrame;
  352. { Sends the NEWFRAME escape call and performs appropriate error
  353.   checking.}
  354. begin
  355.   if Error>=0 then
  356.     Error:=Escape(PrintDC, WINTYPES.NEWFRAME, 0, nil, nil);
  357.   if Error<0 then
  358.     case Error of
  359.       SP_ERROR: MessageBox(Application^.MainWindow^.HWindow,
  360.         'General Printer Error', nil, mb_Ok or mb_IconStop);
  361.       SP_OUTOFDISK: MessageBox(Application^.MainWindow^.HWindow,
  362.         'No disk space for spooling', nil, mb_Ok or mb_IconStop);
  363.       SP_OUTOFMEMORY: MessageBox(Application^.MainWindow^.HWindow,
  364.         'No memory space for spooling', nil, mb_Ok or mb_IconStop);
  365.       SP_USERABORT: MessageBox(Application^.MainWindow^.HWindow,
  366.         'Printing Terminated by User', nil, mb_Ok or mb_IconStop);
  367.     else
  368.       MessageBox(Application^.MainWindow^.HWindow,
  369.         'Printing Halted', nil, mb_OK or mb_IconStop);
  370.     end;
  371. end;
  372.  
  373. procedure TPrinterInfo.NextBand(var R:TRect);
  374. { When Bitmap banding is required, this routine returns the next
  375.   rectangular region to be printed.  This method is not required but
  376.   can speed up printing bitmaps.}
  377. begin
  378.   if Error>=0 then
  379.     Error:=Escape(PrintDC, WINTYPES.NEXTBAND, 0, nil, @R);
  380.   if Error<0 then
  381.     case Error of
  382.       SP_ERROR: MessageBox(Application^.MainWindow^.HWindow,
  383.         'General Printer Error', nil, mb_Ok or mb_IconStop);
  384.       SP_OUTOFDISK: MessageBox(Application^.MainWindow^.HWindow,
  385.         'No disk space for spooling', nil, mb_Ok or mb_IconStop);
  386.       SP_OUTOFMEMORY: MessageBox(Application^.MainWindow^.HWindow,
  387.         'No memory space for spooling', nil, mb_Ok or mb_IconStop);
  388.       SP_USERABORT: MessageBox(Application^.MainWindow^.HWindow,
  389.         'Printing Terminated by User', nil, mb_Ok or mb_IconStop);
  390.     else
  391.       MessageBox(Application^.MainWindow^.HWindow,
  392.         'Printing Halted', nil, mb_OK or mb_IconStop);
  393.     end;
  394. end;
  395.  
  396. procedure TPrinterInfo.EndDoc;
  397. { Sends the ENDDOC escape call and closes the Abort Dialog if no errors
  398.   have occurred.}
  399. begin
  400.   if Error>=0 then
  401.     Error:=Escape(PrintDC, WINTYPES.ENDDOC, 0, nil, nil);
  402.   if Error>=0 then
  403.   begin
  404.     DeleteDC(PrintDC);
  405.     if AbortDialog<>Nil then AbortDialog^.CloseWindow;
  406.   end;
  407. end;
  408.  
  409. procedure TPrinterInfo.DeviceMode;
  410. { Calls the printer driver's DeviceMode routine.  Normally displays a
  411.   dialog allowing the user to change the printer's configuration.}
  412. begin
  413.   DeviceModeVar(Application^.MainWindow^.HWindow,
  414.     DriverHandle, PrinterType, Port);
  415. end;
  416.  
  417. function TPrinterInfo.BitMapCapable: boolean;
  418. { Returns true if the current printing device can handle bitmap
  419.   graphics.}
  420. begin
  421.   BitMapCapable:=(RasterCaps and RC_BITBLT)<>0;
  422. end;
  423.  
  424. function TPrinterInfo.BandingRequired: boolean;
  425. { Returns true if banding of bitmap images will enhance printing speed.}
  426. begin
  427.   BandingRequired:=(RasterCaps and RC_BANDING)<>0;
  428. end;
  429.  
  430. end.
  431.  
  432. { Here are the descriptions of the dialogs PIABORT and PISELECT found in
  433.   the resources file PRINTER.RES
  434.  
  435. PIABORT DIALOG DISCARDABLE LOADONCALL PURE MOVEABLE 44, 46, 175, 78
  436. STYLE WS_POPUP | WS_VISIBLE | WS_CAPTION | 0x80L
  437. CAPTION "Printing in Progress"
  438. BEGIN
  439.   CONTROL "Press Escape to Halt Printing" 101, "STATIC", WS_CHILD |
  440.     WS_VISIBLE, 37, 17, 98, 12
  441.   CONTROL "Escape" 102, "BUTTON", WS_CHILD | WS_VISIBLE | WS_TABSTOP,
  442.     73, 49, 40, 13
  443. END
  444.  
  445. PISELECT DIALOG DISCARDABLE LOADONCALL PURE MOVEABLE 44, 37, 145, 85
  446. STYLE WS_POPUP | WS_VISIBLE | WS_CAPTION | 0x80L
  447. CAPTION "Select Printer"
  448. BEGIN
  449.   CONTROL "COMBOBOX" 101, "COMBOBOX", WS_CHILD | WS_VISIBLE | WS_VSCROLL |
  450.     0x101L, 26, 11, 84, 43
  451.   CONTROL "Ok" 1, "BUTTON", WS_CHILD | WS_VISIBLE | WS_TABSTOP,
  452.     29, 61, 40, 12
  453.   CONTROL "Cancel" 2, "BUTTON", WS_CHILD | WS_VISIBLE | WS_TABSTOP,
  454.     86, 61, 40, 12
  455. END
  456. }
  457.